home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / surfmodl / surfm203.arc / SURFSRC.ARC / SHADING.INC < prev    next >
Text File  |  1988-02-06  |  7KB  |  205 lines
  1. {
  2. From:    SKYBLU::ENNS          5-FEB-1988 22:17
  3. To:    LOWEY
  4. Subj:    surf fix
  5.  
  6. This fix performs the shading calculations without converting them to
  7. normalized coordinates first.  This speeds up the shading calculations
  8. but still provide the same results.
  9.  
  10. Provided to Kevin Lowey by Steve Enns of the University of Saskatchewan,
  11.  
  12.    ENNS@SASK.BITNET
  13. }
  14.  
  15. { type vector = array[1..3] of real; }
  16.  
  17. procedure NORMAL (var V: vector);
  18. { normalize the vector V }
  19. var Vmag: real;                { magnitude of the vector }
  20.     J: integer;                { index }
  21. begin
  22.   Vmag := sqrt (sqr (V[1]) + sqr (V[2]) + sqr (V[3]) );
  23.   if (Vmag > 0.0) then
  24.     for J := 1 to 3 do
  25.       V[J] := V[J] / Vmag;
  26. end; { procedure NORMAL }
  27.  
  28. function POWER (X, P: real): real;
  29. { Raise real number X to the power P }
  30. begin
  31.   if (X > 0) then
  32.     if (P > 0) then
  33.       POWER := exp (P * ln(X))
  34.     else if (P = 0) then
  35.       POWER := 1.0
  36.     else
  37.       POWER := 1.0 / exp (-P * ln(X))
  38.   else if (X = 0) then
  39.     POWER := 0.0
  40.   else
  41.     { Forget the negatives; aren't dealing with complex nos. }
  42.     POWER := 0.0;
  43. end; { function POWER }
  44.  
  45. { Common variable for SETSHADE and SHADING }
  46. var S: array[1..MAXLITE] of vector;   { light source vectors }
  47.  
  48. procedure SETSHADE;
  49. { Set up the light source vectors for the shading routine }
  50. var Lite: integer;
  51.     J: integer;
  52.  
  53. begin
  54.   for Lite := 1 to Nlite do begin
  55.     S[Lite][1] := Xlite[Lite] - Xfocal;
  56.     S[Lite][2] := Ylite[Lite] - Yfocal;
  57.     S[Lite][3] := Zlite[Lite] - Zfocal;
  58.     normal (S[Lite]);
  59.   end;
  60. end; { procedure SETSHADE }
  61.  
  62. function SHADING (Surf, Side: integer): real;
  63. { Calculate the shade of surface Surf at point (X,Y,Z).
  64.   (Returns a negative shade if surface is totally invisible
  65.   [facing away from eye] )
  66.   Side 1 is the primary side of the surface (assumes the nodes are
  67.   numbered counter-clockwise when viewed from the outside of the
  68.   surface). Side 2 is the inside, necessary for viewing surfaces
  69.   that can be seen from either side (such as function plots).
  70. }
  71. var A: vector;                { vector from 1st to 2nd node of surface }
  72.     B: vector;                { vector from 1st to 3rd node of surface }
  73.     N: vector;                { vector normal to surface }
  74.     E: vector;                { vector from 1st node to eye }
  75.     D: vector;                { difference from source to surface normal }
  76.     R: vector;                { vector from 1st node to reflected light }
  77.     J: integer;               { index }
  78.     Node1: integer;           { 1st node # }
  79.     Node2: integer;           { 2nd node # }
  80.     Node3: integer;           { 3rd node # }
  81.     Vmag: real;               { magnitude of vector, reflected lite to eye }
  82.     Cumshade: real;           { cumulative shade (from multiple light sources)}
  83.     Lite: integer;            { light source number }
  84.     CosN: real;               { cosine of angle from light to surface normal }
  85.     CosS: real;               { cosine of angle from reflected light to eye }
  86.  
  87. begin
  88. {$ifdef BIGMEM}
  89. with ptra^ do with ptrb^ do with ptrc^ do with ptri^ do
  90. begin
  91. {$endif}
  92.   if (Side = 1) then begin
  93.     Node1 := Konnec (Surf, 1);
  94.     Node2 := Konnec (Surf, 2);
  95.     Node3 := Konnec (Surf, 3);
  96.   end else begin
  97.     Node1 := Konnec (Surf, 1);
  98.     Node2 := Konnec (Surf, 3);
  99.     Node3 := Konnec (Surf, 2);
  100.   end;
  101.   A[1] := Xworld[Node2] - Xworld[Node1];
  102.   A[2] := Yworld[Node2] - Yworld[Node1];
  103.   A[3] := Zworld[Node2] - Zworld[Node1];
  104.   B[1] := Xworld[Node3] - Xworld[Node1];
  105.   B[2] := Yworld[Node3] - Yworld[Node1];
  106.   B[3] := Zworld[Node3] - Zworld[Node1];
  107.  
  108. { Vector cross product N = A X B }
  109.   N[1] := A[2]*B[3] - A[3]*B[2];
  110.   N[2] := A[3]*B[1] - A[1]*B[3];
  111.   N[3] := A[1]*B[2] - A[2]*B[1];
  112.   normal(N);
  113.  
  114.   E[1] := Xeye - Xworld[Node1];
  115.   E[2] := Yeye - Yworld[Node1];
  116.   E[3] := Zeye - Zworld[Node1];
  117.   normal(E);
  118.  
  119. { Is surface visible to eye? }
  120.   if (E[1]*N[1] + E[2]*N[2] + E[3]*N[3] < 0.0) then
  121.     Shading := -1.0
  122.   else begin
  123.     Cumshade := Ambient[Matl[Surf]];
  124.     for Lite := 1 to Nlite do begin
  125.       for J := 1 to 3 do
  126.         D[J] := S[Lite][J] - N[J];
  127.       { Does surface face away from light source? }
  128.       CosN := S[Lite][1]*N[1] + S[Lite][2]*N[2] + S[Lite][3]*N[3];
  129.       if (CosN < 0.0) then
  130.         { Cumshade := Cumshade + 0.0;} { this light source doesn't contribute}
  131.       else begin
  132.         for J := 1 to 3 do
  133.           R[J] := N[J] - D[J];
  134.         normal(R);
  135.         { Find magnitude of vector from reflected light to eye (divided by 2) }
  136.         Vmag := sqrt (sqr(E[1]-R[1]) + sqr(E[2]-R[2]) + sqr(E[3]-R[3])) / 2.0;
  137.         if (Vmag > 1.0) then
  138.           Vmag := 1.0;
  139.         CosS := 1.0 - sqr(Vmag);
  140.         Cumshade := Cumshade + Intensity[Lite] * (R1[Matl[Surf]] *
  141.                power(CosS, R2[Matl[Surf]]) + R3[Matl[Surf]] * CosN);
  142.       end; { if sqr(D[1]... }
  143.     end; { for Lite }
  144.     Shading := Cumshade;
  145.   end; { if sqr(E[1]... }
  146. {$ifdef BIGMEM}
  147. end; {with}
  148. {$endif}
  149. end; { function SHADING }
  150.  
  151. function VISIBLE (Surf, Side: integer): boolean;
  152. { Determine visibility of surface #Surf. If visible, return TRUE.
  153.   If invisible, return FALSE.
  154. }
  155. var A: vector;                { vector from 1st to 2nd node of surface }
  156.     B: vector;                { vector from 1st to 3rd node of surface }
  157.     N: vector;                { vector normal to surface }
  158.     E: vector;                { vector from 1st node to eye }
  159.     Node1: integer;           { 1st node # }
  160.     Node2: integer;           { 2nd node # }
  161.     Node3: integer;           { 3rd node # }
  162.  
  163. begin
  164. {$ifdef BIGMEM}
  165. with ptra^ do with ptrb^ do with ptrc^ do
  166. begin
  167. {$endif}
  168.  
  169.   if (Side = 1) then begin
  170.     Node1 := Konnec (Surf, 1);
  171.     Node2 := Konnec (Surf, 2);
  172.     Node3 := Konnec (Surf, 3);
  173.   end else begin
  174.     Node1 := Konnec (Surf, 3);
  175.     Node2 := Konnec (Surf, 2);
  176.     Node3 := Konnec (Surf, 1);
  177.   end;
  178.   A[1] := Xworld[Node2] - Xworld[Node1];
  179.   A[2] := Yworld[Node2] - Yworld[Node1];
  180.   A[3] := Zworld[Node2] - Zworld[Node1];
  181.   B[1] := Xworld[Node3] - Xworld[Node1];
  182.   B[2] := Yworld[Node3] - Yworld[Node1];
  183.   B[3] := Zworld[Node3] - Zworld[Node1];
  184.  
  185. { Vector cross product N = A X B }
  186.   N[1] := A[2]*B[3] - A[3]*B[2];
  187.   N[2] := A[3]*B[1] - A[1]*B[3];
  188.   N[3] := A[1]*B[2] - A[2]*B[1];
  189. {  normal(N);                             ******* Not required }
  190.  
  191.   E[1] := Xeye - Xworld[Node1];
  192.   E[2] := Yeye - Yworld[Node1];
  193.   E[3] := Zeye - Zworld[Node1];
  194. {  normal(E);                             ******* Not required }
  195.  
  196. { Is surface visible to eye? }
  197.   if (E[1]*N[1] + E[2]*N[2] + E[3]*N[3] < 0.0) then
  198.     Visible := FALSE
  199.   else
  200.     Visible := TRUE;
  201. {$ifdef BIGMEM}
  202. end; {with}
  203. {$endif}
  204. end; { function VISIBLE }
  205.